home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-20 / minimuf4.zip / MINIMUF4.BAS < prev    next >
BASIC Source File  |  1990-10-16  |  12KB  |  292 lines
  1. 1 REM     MINIMUF4.BAS     VERSION 4.1
  2. 3 REM     ADAPTATION 2.0 FOR IBM PC    AT 2325Z 25 JUL 86
  3. 5 REM     ORIGINAL SOURCE: QST DECEMBER 1982    Pg. 38
  4. 6 REM     SOURCE OF POLYNOMIAL FLUX TO SUNSPOT # CONVERSION: GILDER, JAMES H.;
  5. 7 REM     BASIC COMPUTER PROGRAMS IN SCIENCE AND ENGINEERING; HAYDEN 1980
  6. 9 REM     ADAPTATION BY R. DEAN STRAW, N6BV, JUL 25, 1986
  7. 14 REM     SAMPLE DRIVER FOR MINIMUF   4.1
  8. 15 REM     INITIAL DATA
  9. 16 CLS:KEY OFF
  10. 17 DIM M$(37),A$(4),M(12)
  11. 18 FOR I=1 TO 12
  12. 19 READ M(I)
  13. 20 NEXT I
  14. 21 DATA 31,28,31,30,31,30,31,31,30,31,30,31
  15. 22 M$="JanFebMarAprMayJunJulAugSepOctNovDec"
  16. 23 PI=3.141593: R0=PI/180: P1=2*PI: R1=180/PI: P0=PI/2: X$=STRING$(79,61)
  17. 24 DEF FNACS(X)=-ATN(X/SQR(-X*X+1))+1.5708: GOSUB 238: REM SCREEN HEADER
  18. 25 PRINT: PRINT "Initialization":PRINT
  19. 26 PRINT: PRINT: INPUT "First, Give a Label for Your (Transmitter) Location: ",CS$
  20. 27 PRINT :INPUT "Enter Your Latitude, Longitude (``-'' for East & South): ",L9,W9
  21. 28 IF L9=>-90 AND L9<=90 THEN 30: PRINT "Invalid Latitude.  Must Be in Range (-90 TO +90)"
  22. 29 GOTO 27
  23. 30 IF -360<=W9 AND W9<=360 THEN 32
  24. 31 PRINT "Invalid Longitude.  Must Be in Range (-360 TO +360)":GOTO 27
  25. 32 CS$="From "+CS$: CLS
  26. 33 GOSUB 238: PRINT "Path Options":PRINT
  27. 35 PRINT 1,CS$;" To E.Coast USA (Washington, D.C.)"
  28. 36 PRINT 2,CS$;" To South America (Asuncion, Paraguay)"
  29. 37 PRINT 3,CS$;" To W.Coast SA (Lima, Peru)"
  30. 38 PRINT 4,CS$;" To Hawaii (Honolulu)"
  31. 39 PRINT 5,CS$;" To Japan (Tokyo)"
  32. 40 PRINT 6,CS$;" To Australia (Melbourne)"
  33. 41 PRINT 7,CS$;" To S.Asia (Bangkok, Thailand)"
  34. 42 PRINT 8,CS$;" To Central Asia (New Delhi, India)"
  35. 43 PRINT 9,CS$;" To W.Europe (London, England)"
  36. 44 PRINT 10,CS$;" To E.Europe (Kiev, Ukraine)"
  37. 45 PRINT 11,CS$;" To USSR (Moscow)"
  38. 46 PRINT 12,CS$;" To N.Africa (Cairo, Egypt)"
  39. 47 PRINT 13,CS$;" To W.Coast Africa (Liberia)"
  40. 48 PRINT 14,CS$;" To E. Coast Africa (Nairobi, Kenya)"
  41. 49 PRINT 15,CS$;" To S. Africa (Lusaka, Zambia)"
  42. 50 PRINT 16,CS$;" To a Specified Point"
  43. 51 PRINT 17,"Between Specified Points":PRINT 18,"Exit Program"
  44. 52 PRINT: INPUT "Your Choice: ",CH
  45. 53 IF CH<1 OR CH>18 THEN CLS:LOCATE 12,30:PRINT "Bad Choice Number":FOR X=1 TO 2000:NEXT X:CLS:GOTO 31
  46. 54 IF CH=18 THEN CLS: SYSTEM 
  47. 55 GOSUB 238 :REM TO PRINT SCREEN HEADER
  48. 56 IF CH=17 THEN GOTO 57 ELSE GOTO 267
  49. 57 T$="From Transmitter": R$="To Receiver":PRINT "From Point to Point"
  50. 58 PRINT :INPUT "Transmitter Lat,Lon (use ''-'' for East & South): ",L9,W9
  51. 59 IF L9=>-90 AND L9<=90 THEN 62
  52. 60 PRINT "Invalid Latitude.  Must Be in Range (-90 TO +90)"
  53. 61 GOTO 58
  54. 62 IF -360<=W9 AND W9<=360 THEN 65
  55. 63 PRINT "Invalid Longitude.  Must Be in Range (-360 TO +360)"
  56. 64 GOTO 58
  57. 65 PRINT :INPUT "Receiver Lat, Lon (use ''-'' for East & South): ",L2,W2
  58. 66 IF -90<=L2 AND L2<=90 THEN 69
  59. 67 PRINT "Invalid Latitude. Must Be in Range (-90 TO +90)"
  60. 68 GOTO 65
  61. 69 IF -360<=W2 AND W2<=360 THEN 72
  62. 70 PRINT "Invalid Longitude. Must Be in Range (-360 TO +360)":CLS:GOSUB 238
  63. 71 GOTO 65
  64. 72 IF CH <>17 THEN PRINT: PRINT CS$ +" "+ R$
  65. 73 PRINT: INPUT "Date (Month,Day): ",M0,D6: IF 1<=M0 AND M0<=12 THEN 76
  66. 74 PRINT "Invalid Month. Must Be in Range (1 TO 12)":CLS:GOSUB 238
  67. 75 GOTO 72
  68. 76 IF 1<=D6 AND D6<=M(M0) THEN 80
  69. 77 PRINT "Invalid Day. Must Be in Range (1 TO ";M(M0);")"
  70. 78 GOTO 72
  71. 79 REM   SUN SPOT DATA
  72. 80 PRINT :INPUT "State Source of Solar Activity - S= Sunspot #  F= Solar Flux: ",AN1$
  73. 81 IF AN1$="S" OR AN1$="s" THEN 88 ELSE IF AN1$="F" OR AN1$="f" THEN 82 ELSE 80
  74. 82 INPUT "Smoothed Mean 10.7cm Solar Flux: ",SF
  75. 83 IF SF<65 THEN PRINT "Invalid Flux Number, Must Be Greater Than 65.":GOTO 82
  76. 84 IF SF>245 THEN PRINT "Results May Be Inaccurate for Flux Greater Than 245."
  77. 85 GOSUB 263  :REM   TO ROUTINE FOR FLUX TO SUNSPOT NUMBER CONVERSION
  78. 86 PRINT "A Flux of";SF;"Equates to a Sunspot Number of";S9
  79. 87 GOTO 93
  80. 88 PRINT :INPUT "3-Day Smoothed International Sunspot Number: ",S9
  81. 89 IF S9>=0 THEN 93
  82. 90 PRINT "Invalid Sunspot Number.  Must Be Non-Negative."
  83. 91 GOTO 88
  84. 92 REM   HARD COPY FLAG
  85. 93 PRINT :PRINT :INPUT "Do You Want Hard Copy Printout (Y/N)?: ",AN$
  86. 94 IF AN$="Y" OR AN$="y" THEN LP=1 ELSE IF AN$="N" OR AN$="n" THEN LP=0 ELSE GOTO 93
  87. 95 REM   THRESHOLD FLAG
  88. 96 PRINT :PRINT :INPUT "Do You Want Flag on MUF Above Given Freq (Y/N)?: ",TA$
  89. 97 IF TA$="Y" OR TA$="y" THEN TA=1 ELSE IF TA$="N" OR TA$="n" THEN TA=0 ELSE GOTO 96
  90. 98 IF TA=1 THEN INPUT "Specify Freq in MHz: ",TAM
  91. 99 CLS
  92. 100 A$=MID$(M$,3*M0-2,3)
  93. 101 GOSUB 238  :REM   TO PRINT SCREEN HEADER
  94. 102 PRINT :PRINT "Date: ";A$;D6
  95. 103 PRINT :PRINT T$; TAB(43) R$
  96. 104 PRINT "Latitude:";L9;"  Longitude:";W9; TAB(43)  "Latitude:";L2;"   Longitude:";W2
  97. 105 PRINT :PRINT "Sunspot Number =";S9:GOSUB 300
  98. 106 PRINT:PRINT "Range = ";INT(DX+.5);"Statute Miles    ";"Bearing = ";INT(B1+.5);"Degrees"
  99. 107 PRINT:COLOR 10
  100. 108 PRINT "  MUF(MHz)    UTC";
  101. 109 FOR I=5 TO 55 STEP 5
  102. 110 COLOR 7:LOCATE ,19+I:PRINT I;
  103. 111 NEXT I
  104. 112 COLOR 10:PRINT "  ========    ===";:COLOR 7
  105. 113 LOCATE ,20:PRINT"|====|====|====|====|====|====|====|====|====|====|====|="
  106. 114 IF LP=1 THEN GOSUB 245
  107. 115 L1=L9*R0: W1=W9*R0: L2=L2*R0: W2=W2*R0: T5=23:GOSUB 146:IF TA=0 THEN D$="*"
  108. 116 IF TA=1 THEN IF J9=>TAM THEN D$="*" ELSE D$="."
  109. 117 T5=0:PRINT USING "    ##.#";J9;:PRINT TAB(15) T5 TAB(20) "|";
  110. 118 LOCATE ,20+CINT(J9):COLOR 10:PRINT D$ :COLOR 7
  111. 119 IF LP=1 THEN LPRINT USING "    ##.#";J9;: LPRINT TAB(15) T5 TAB(20) "|" TAB(20+CINT(J9)) D$
  112. 121 FOR T5=0 TO 22
  113. 122 GOSUB 146 :REM   TO MAIN CALCULATION LOOP
  114. 123 REM  SCREEN AND PRINTER DATA PRINT
  115. 124 IF TA=0 THEN D$="*"
  116. 125 IF TA=1 THEN IF J9=>TAM THEN D$="*" ELSE D$="."
  117. 126 PRINT USING "    ##.#";J9;:PRINT TAB(15) T5+1 TAB(20) "|";
  118. 127 LOCATE ,20+CINT(J9):COLOR 10:PRINT D$ :COLOR 7
  119. 128 IF LP=1 THEN LPRINT USING "    ##.#";J9;:LPRINT TAB(15) T5+1 TAB(20) "|" TAB(20+CINT(J9)) D$
  120. 129 NEXT T5
  121. 130 REM   SCREEN AND PRINTER ENDING
  122. 131 LOCATE ,20:PRINT"|====|====|====|====|====|====|====|====|====|====|====|="
  123. 132 FOR I=5 TO 55 STEP 5
  124. 133 LOCATE ,19+I:PRINT I;
  125. 134 NEXT I
  126. 135 IF LP=1 THEN 136 ELSE 141
  127. 136 LPRINT TAB(20) "|====|====|====|====|====|====|====|====|====|====|====|="
  128. 137 FOR I=5 TO 55 STEP 5
  129. 138 LPRINT TAB(19+I)  I;
  130. 139 NEXT I
  131. 140 LPRINT CHR$(12)
  132. 141 BEEP:BEEP:BEEP:PRINT
  133. 142 REM: TO INTRODUCE A DELAY USE -- FOR X=1 TO 4000:NEXT X
  134. 143 INPUT "Press Return to Perform Next Case: ",X
  135. 144 CLS
  136. 145 IF CH=17 THEN GOTO 25 ELSE GOTO 33
  137. 146 REM   MINIMUF 4.1 CALCULATION LOOP
  138. 147 K7=SIN(L1)*SIN(L2)+COS(L1)*COS(L2)*COS(W2-W1)
  139. 148 IF K7=>-1 THEN 151
  140. 149 K7=-1
  141. 150 GOTO 153
  142. 151 IF K7<=1 THEN 153
  143. 152 K7=1
  144. 153 G1=FNACS(K7)
  145. 154 K6=1.59*G1
  146. 155 IF K6>=1 THEN 157
  147. 156 K6=1
  148. 157 K5=1/K6
  149. 158 J9=100
  150. 159 FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP .9999-1/K6
  151. 160 IF K5=1 THEN 162
  152. 161 K5=.5
  153. 162 P=SIN(L2)
  154. 163 Q=COS(L2)
  155. 164 A=(SIN(L1)-P*COS(G1))/(Q*SIN(G1))
  156. 165 B=G1*K1
  157. 166 C=P*COS(B)+Q*SIN(B)*A
  158. 167 D=(COS(B)-C*P)/(Q*SQR(1-C^2))
  159. 168 IF D=>-1 THEN 171
  160. 169 D=-1
  161. 170 GOTO 173
  162. 171 IF D<=1 THEN 173
  163. 172 D=1
  164. 173 D=FNACS(D)
  165. 174 W0=W2+SGN(SIN(W1-W2))*D
  166. 175 IF W0=>0 THEN 177
  167. 176 W0=W0+P1
  168. 177 IF W0<P1 THEN 179
  169. 178 W0=W0-P1
  170. 179 IF C=>-1 THEN 182
  171. 180 C=-1
  172. 181 GOTO 184
  173. 182 IF C<=1 THEN 184
  174. 183 C=1
  175. 184 L0=P0-FNACS(C)
  176. 185 Y1=.0172*(10+(M0-1)*30.4+D6)
  177. 186 Y2=.409*COS(Y1)
  178. 187 K8=3.82*W0+12+.13*(SIN(Y1)+1.2*SIN(2*Y1))
  179. 188 K8=K8-12*(1+SGN(K8-24))*SGN(ABS(K8-24))
  180. 189 IF COS(L0+Y2)>-.26 THEN 198
  181. 190 K9=0
  182. 191 G0=0
  183. 192 M9=2.5*G1*K5
  184. 193 IF M9<=P0 THEN 195
  185. 194 M9=P0
  186. 195 M9=SIN(M9)
  187. 196 M9=1+2.5*M9*SQR(M9)
  188. 197 GOTO 223
  189. 198 K9=(-.26+SIN(Y2)*SIN(L0))/(COS(Y2)*COS(L0)+9.999999E-04)
  190. 199 K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.639437
  191. 200 T=K8-K9/2+12*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2))
  192. 201 T4=K8+K9/2-12*(1+SGN(K8+K9/2-24))*SGN(ABS(K8+K9/2-24))
  193. 202 C0=ABS(COS(L0+Y2))
  194. 203 T9=9.7*C0^9.600001
  195. 204 IF T9>.1 THEN 206
  196. 205 T9=.1
  197. 206 M9=2.5*G1*K5
  198. 207 IF M9<=P0 THEN 209
  199. 208 M9=P0
  200. 209 M9=SIN(M9)
  201. 210 M9=1+2.5*M9*SQR(M9)
  202. 211 IF T4<T THEN 214
  203. 212 IF (T5-T)*(T4-T5)>0 THEN 215
  204. 213 GOTO 228
  205. 214 IF (T5-T4)*(T-T5)>0 THEN 228
  206. 215 T6=T5+12*(1+SGN(T-T5))*SGN(ABS(T-T5))
  207. 216 G9=PI*(T6-T)/K9
  208. 217 G8=PI*T9/K9
  209. 218 U=(T-T6)/T9
  210. 219 G0=C0*(SIN(G9)+G8*(EXP(U)-COS(G9)))/(1+G8*G8)
  211. 220 G7=C0*(G8*(EXP(-K9/T9)+1))*EXP((K9-24)/2)/(1+G8*G8)
  212. 221 IF G0=>G7 THEN 223
  213. 222 G0=G7
  214. 223 G2=(1+S9/250)*M9*SQR(6+58*SQR(G0))
  215. 224 G2=G2*(1-.1*EXP((K9-24)/3))
  216. 225 G2=G2*(1+(1-SGN(L1)*SGN(L2))*.1)
  217. 226 G2=G2*(1-.1*(1+SGN(ABS(SIN(L0))-COS(L0))))
  218. 227 GOTO 234
  219. 228 T6=T5+12*(1+SGN(T4-T5))*SGN(ABS(T4-T5))
  220. 229 G8=PI*T9/K9
  221. 230 U=(T4-T6)/2
  222. 231 U1=-K9/T9
  223. 232 G0=C0*(G8*(EXP(U1)+1))*EXP(U)/(1+G8*G8)
  224. 233 GOTO 223
  225. 234 IF G2>J9 THEN 236
  226. 235 J9=G2
  227. 236 NEXT K1
  228. 237 RETURN
  229. 238 REM  SCREEN HEADER
  230. 239 CLS: COLOR 0,7
  231. 240 PRINT X$
  232. 241 PRINT TAB(27) "MINIMUF, Ver. 4.1, by N6BV" STRING$(27,32)
  233. 242 COLOR 7,0
  234. 243 REM
  235. 244 RETURN
  236. 245 REM   HEADER FOR PRINTER
  237. 246 REM 
  238. 247 LPRINT 
  239. 248 LPRINT TAB(31) "MINIMUF, Version 4.1"
  240. 249 LPRINT TAB(31) "===================="
  241. 250 LPRINT TAB(31) " Fine Tuned by N6BV"
  242. 251 LPRINT :LPRINT "Date: ";A$;D6
  243. 252 LPRINT :LPRINT T$; TAB(43) R$
  244. 253 LPRINT "Latitude:";L9;" Longitude:";W9; TAB(43) "Latitude:";L2;" Longitude:";W2
  245. 254 LPRINT :LPRINT "Sunspot Number = ";S9:LPRINT
  246. 255 LPRINT "Range = ";INT(DX+.5);"Statute Miles    "; "Bearing = ";INT(B1+.5);"Degrees"
  247. 256 LPRINT: LPRINT "  MUF(MHz)    UTC";
  248. 257 FOR I=5 TO 55 STEP 5
  249. 258 LPRINT TAB(19+I) I;
  250. 259 NEXT I
  251. 260 LPRINT "  ========    ===";
  252. 261 LPRINT TAB(20) "|====|====|====|====|====|====|====|====|====|====|====|="
  253. 262 RETURN
  254. 263 REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  255. 264 S9=-103.7767+1.797429*SF-(3.384356E-03)*SF^2+(4.525515E-06)*SF^3
  256. 265 S9=INT(100*S9+.5)/100
  257. 266 RETURN
  258. 267 REM   PATH OPTION LAT/LON
  259. 268 T$=CS$ 
  260. 269 IF CH=1 THEN L2=38:W2=75:R$="To E.Coast USA (Wash.D.C.) ":GOTO 72
  261. 270 IF CH=2 THEN L2=-25.3:W2=58:R$="To South America (Asuncion, Paraguay) ":GOTO 72
  262. 271 IF CH=3 THEN L2=-12:W2=77:R$="To W.Coast SA (Lima, Peru) ":GOTO 72
  263. 272 IF CH=4 THEN L2=22:W2=158:R$="To Hawaii (Honolulu) ":GOTO 72
  264. 273 IF CH=5 THEN L2=36:W2=-140:R$="To Japan (Tokyo) ":GOTO 72
  265. 274 IF CH=6 THEN L2=-38:W2=-145:R$="To Australia (Melbourne) ":GOTO 72
  266. 275 IF CH=7 THEN L2=14:W2=-102:R$="To S.Asia (Bangkok, Thailand) ":GOTO 72
  267. 276 IF CH=8 THEN L2=28:W2=-77:R$="To Central Asia (New Delhi, India) ":GOTO 72
  268. 277 IF CH=9 THEN L2=51.5:W2=-.1:R$="To W.Europe (London, England) ":GOTO 72
  269. 278 IF CH=10 THEN L2=50.5:W2=-31:R$="To E.Europe (Kiev, Ukraine) ":GOTO 72
  270. 279 IF CH=11 THEN L2=56:W2=-38:R$="To USSR (Moscow) ":GOTO 72
  271. 280 IF CH=12 THEN L2=30:W2=-32:R$="To N.Africa (Cairo, Egypt) ":GOTO 72
  272. 281 IF CH=13 THEN L2=8:W2=-10:R$="To W.Coast Africa (Liberia) ":GOTO 72
  273. 282 IF CH=14 THEN L2=-2:W2=-37:R$="To E.Coast Africa (Kenya) ":GOTO 72
  274. 283 IF CH=15 THEN L2=-15:W2=-28:R$="TO S.Africa (Lusaka, Zambia) ":GOTO 72
  275. 284 IF CH=16 THEN R$="To Receiver ": PRINT CS$+" To a Receiver Point" :GOTO 65
  276. 300 REM SUBROUTINE TO CALCULATE RANGE AND BEARING
  277. 305 Z1=L9*R0:Z2=L2*R0:Z3=W9*R0:Z4=W2*R0
  278. 310 R7=SIN(Z1)*SIN(Z2)+COS(Z1)*COS(Z2)*COS(Z4-Z3)
  279. 320 IF R7=>-1 THEN 350
  280. 330 R7=-1
  281. 340 GOTO 370
  282. 350 IF R7<=1 THEN 370
  283. 360 R7=1
  284. 370 R8=FNACS(R7):REM R8 IS DISTANCE IN RADIANS
  285. 380 DX=R8*180/PI*69.041:REM RANGE IN STATUTE MILES
  286. 390 C1=(SIN(Z2)-SIN(Z1)*R7)/(COS(Z1)*SIN(R8))
  287. 400 IF C1>=1 THEN B0=0:GOTO 420 ELSE IF C1<=-1 THEN B0=180/(180/PI):GOTO 420
  288. 410 B0=FNACS(C1)
  289. 420 B1=B0*180/PI
  290. 430 IF SIN(Z3-Z4)<0 THEN B1=360-B1
  291. 440 RETURN
  292.